home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / editors / emcs1858 / 1858b-d3.zoo / e-lisp / getris.elc < prev    next >
Encoding:
Text File  |  1992-05-20  |  9.5 KB  |  179 lines
  1.  
  2. (provide (quote getris))
  3.  
  4. (defvar getris-initial-delay 10 "\
  5. *delay count to control the speed of getris game.  bigger means slower.
  6. You should substitute this value according to your system's performance.")
  7.  
  8. (defvar getris-min-delay 2 "\
  9. *Minimum delay count to control the maximum speed of getris game.
  10. Smaller means faster.  The default value, 2, means `as fast as possible.'")
  11.  
  12. (defvar getris-acceleration 200 "\
  13. *Acceleration rate of getris game.
  14. Smaller value means quicker speed-up.  This value is performance independent.")
  15.  
  16. (defvar getris-high-score-file (or (getenv "GETRISFILE") "$HOME/.getris") "\
  17. *File name where top ten scores of getris are recorded.
  18. Initialized from GETRISFILE environment variable.
  19. Nil means does not record scores.")
  20.  
  21. (defvar getris-block-string (if (and (boundp (quote kanji-flag)) kanji-flag)
  22. "**" "**") "\ *String for getris block.  Must be width of two column.")
  23.  
  24. (defvar getris-width 10 "\
  25. *Width of getris board (number of blocks).  Each block occupies two
  26. column width on window.")
  27.  
  28. (defvar getris-use-full-window nil "\
  29. *Non-nil means that starting Getris game deletes other windows.")
  30.  
  31. (defun getris nil "\
  32. Clone of a famous Russian game program." (interactive) (byte-code "IJêא ë⓪êבג!êד êה ç" [getris-previous-window-configuration nil current-window-configuration switch-to-buffer "*Getris*" getris-mode getris-startup] 5))
  33.  
  34. (defvar getris-command-vector nil "\
  35. Vector of functions which maps character to getris command.")
  36.  
  37. (defvar getris-mode-map nil)
  38.  
  39. (defvar getris-piece-data nil "\
  40. Vector of piece data.
  41. Each element of this vector is vector of size four, which correspond
  42. to four directions of piece.  And each element of four size vectors is
  43. a list of form:
  44.     (max-y-offset (x1 . y1) (x2 . y2) (x3 . y3) (x4 . y4))
  45. where:
  46.     (x1 . y1) ... (x4 . y4) are offsets of dot from imaginary `origin'
  47.                 at upper-left side of the piece,
  48.     0 <= y[1-4] <= max-y-offset.")
  49.  
  50. (defvar getris-left-margin)
  51.  
  52. (defvar getris-height)
  53.  
  54. (defvar getris-previous-window-configuration nil)
  55.  
  56. (defvar getris-blank-line)
  57.  
  58. (defvar getris-complete-line)
  59.  
  60. (defvar getris-line-length)
  61.  
  62. (defun getris-startup nil (byte-code "IJë⓪êב êebêגד!cêהed\"êאë⓪ç" [buffer-read-only nil t erase-buffer substitute-command-keys "
  63.  
  64. <<< G E T R I S >>>
  65.  
  66. Clone of a famous Russian game program.
  67.  
  68. Originally written by
  69. MAEDA Atusi
  70. mad@nakanishi.math.keio.junet
  71.  
  72.  
  73. <Type \\[getris-mode-help] for help, \\[getris-start] to start game.>
  74. " center-region] 5))
  75.  
  76. (defun getris-mode-help nil (interactive) (byte-code "ijêIJאבג!בד!בה!בו!בז!%!ç" [nil message concat substitute-command-keys "\\[getris-mode-help]:Print this  " "\\[getris-start]:Start new game  " "\\[getris-help]:List action keys  " "\\[boss-has-come]:Boss has come!  " "\\[getris-exit]:Exit"] 12))
  77.  
  78. (or getris-mode-map (progn (setq getris-mode-map (make-sparse-keymap)) (define-key getris-mode-map "?" (quote getris-mode-help)) (define-key getris-mode-map "
  79. " (quote getris-start)) (define-key getris-mode-map "h" (quote getris-help)) (define-key getris-mode-map "" (quote boss-has-come)) (define-key getris-mode-map "q" (quote getris-exit))))
  80.  
  81. (defun getris-help nil (interactive) (byte-code "ijêIJא!ç" [nil message "j:Left  k:Rotate  l:Right  Space:Drop  ESC:Escape  q:Exit"] 2))
  82.  
  83. (or getris-command-vector (progn (setq getris-command-vector (make-vector 256 (quote getris-help))) (aset getris-command-vector 106 (quote getris-move-left)) (aset getris-command-vector 107 (quote getris-rotate)) (aset getris-command-vector 108 (quote getris-move-right)) (aset getris-command-vector 32 (quote getris-drop)) (aset getris-command-vector 113 (quote getris-quit)) (aset getris-command-vector 27 (quote getris-boss-has-come))))
  84.  
  85. (defun getris-mode nil "\
  86. Major mode for playing getris game.
  87. \\{getris-mode-map}
  88. Type \\[getris-help] for key action in the game.
  89. Entry to this mode calls the value of getris-mode-hook
  90. if that value is non-nil." (interactive) (byte-code "דêה êוז!êחë⓪êטë①êי
  91. !êכp!êגë③êל êמנ!ç" [major-mode mode-name getris-mode-map buffer-read-only t nil kill-all-local-variables make-local-variable global-mode-string getris-mode "Getris" use-local-map buffer-flush-undo getris-mode-help run-hooks getris-mode-hook] 7))
  92.  
  93. (defun getris-start nil (interactive) (byte-code "יêלמ!ê✓âנ é.ס ê    עWà\"פצקע    Z\"Tא\"ê♪רWà.פר♪Z!êס ê♪רWå;    עWàAשת!êן    Sך\" םןצק╱\"ך\"ףRë⑤êץ ם§✓╱\"םR!ë⑥◆ê
  94. Gë⑥    êיë⑥
  95. ê∧ ê∞  ♪Wàî
  96. cê Të⑥ êéx)ê ןαצק╱\"\\β\"Pc)êΓא!êπΣìç" [getris-use-full-window getris-left-margin t getris-height left-margin-space getris-blank-line getris-width getris-complete-line getris-block-string getris-line-length buffer-read-only nil i switch-to-buffer "*Getris*" delete-other-windows getris-get-window-size 5 enlarge-window * 2 20 error "Window size too small for getris." make-string 32 "||" "||
  97. " regexp-quote getris-repeat-string erase-buffer 0 4 61 random getris-quit-tag (byte-code "ij êIJ ç" [getris-main-loop getris-mode-help] 3)] 20))
  98.  
  99. (defun getris-get-window-size nil (byte-code "ב גZë⓪êדהו זג
  100. \"ח#ג\"ë①ç" [getris-height getris-left-margin getris-width window-height 2 / - window-width * 4] 8))
  101.  
  102. (defun getris-repeat-string (string times) (byte-code "ב⑧    גVà⑥
  103. ✓Pë⓪ê    Së①êé⇩ê✓)ç" [result times string "" 0] 3))
  104.  
  105. (defun getris-exit nil (interactive) (byte-code "IJêא✓!ç" [getris-previous-window-configuration nil set-window-configuration] 2))
  106.  
  107. (defun abs (number) (byte-code "✓IJWâ♪✓[é ✓ç" [number 0] 2))
  108.  
  109. (defun getris-main-loop nil (byte-code "    תתן
  110. ך╱ם\"ף#ץ╱§\"∧∧∧∧∧ ♪
  111.     ✓◆ə⑧ ∞αβ ◆\"ם\"\\⑥    Γ⑥
  112. απβ !§\"⑥♪απβ !Σ\"⑥
  113. 
  114. H⑥♪Hë⑥⓪êσ    ת⓪#àםσ    
  115. T⓪#à†µ    
  116. Të⑥
  117. ⓪#êτ①Φ    ץ♪②\"Z#ë⓪ê✓ë⑥✓ê✓Së⑥✓תVà«♪Të③êΘ à¬Ω③rH!êéÅêδ    
  118. ⓪#êébêµ    
  119. ⓪#êן
  120. ⓪@∮
  121. ⓪\"#ë②êϕ êé&ê∈ם!ê∩cêרë⑥④ê⑥à∈≡ .
  122. ç" [delay getris-initial-delay score loop-count center getris-left-margin getris-width disp delay-count x y direction kind piece-num piece-vector getris-piece-data piece-data getris-min-delay getris-acceleration getris-command-vector buffer-read-only t getris-high-score-file 0 + logior 1 -2 / 4 nil ash mod random -1 abs 7 getris-puttable-p getris-set-piece max 2 input-pending-p funcall getris-unset-piece getris-test-delete-line getris-show-score end-of-line "*** GAME OVER ***" getris-show-high-score] 28))
  123.  
  124. (defmacro getris-goto-x-y (x y) (byte-code "אבג✓דE    הFDç" [y x goto-char + * getris-line-length 1] 5))
  125.  
  126. (defmacro sit-for-getris (n) (byte-code "IJאב✓DEç" [n progn (goto-char (point-min)) sit-for] 4))
  127.  
  128. (defun getris-puttable-p (x y piece-data) (byte-code "IJ⑧
  129. Aë②à
  130. ✓à-וז♪
  131. @A\\ \"
  132. @@\\ח#bêgטU?à)הë⓪êé⇩ê✓)ç" [result t piece-data y getris-line-length x nil + * 1 32] 6))
  133.  
  134. (defun getris-set-piece (x y piece-data) (byte-code "✓Aë⓪à*דה    ✓@A\\
  135. \"♪✓@@\\ו#bêזח!ê cêebêטי!êéç" [piece-data y getris-line-length x getris-block-string + * 1 delete-char 2 sit-for 0] 6))
  136.  
  137. (defun getris-unset-piece (x y piece-data) (byte-code "✓Aë⓪à#גד    ✓@A\\
  138. \"♪✓@@\\ה#bêוז!êחcêéç" [piece-data y getris-line-length x + * 1 delete-char 2 "  "] 6))
  139.  
  140. (defun getris-test-delete-line (y piece-data) (byte-code "    
  141. @\\ו⑧    ✓XàUזח     \"וט#bêי
  142. !àL♪Të③êכ êל`מט!ê`\"ê╱cêנט!êל`סט!ê`\"êebê╱cêebêנו!ê    Të①êé◆êח♪♪♪#*ç" [max-y y piece-data lines-deleted getris-line-length getris-complete-line getris-blank-line 0 + * 1 looking-at ding delete-region next-line sit-for previous-line] 14))
  143.  
  144. (defun getris-show-score nil (byte-code "אב    \"ë⓪êèג q)êדה !êוז!ç" [global-mode-string score format "Score: %d" other-buffer set-buffer-modified-p buffer-modified-p sit-for 0] 6))
  145.  
  146. (defun getris-show-high-score nil (byte-code "ב    !⑧ג✓!êdbêדה
  147. ו ז ח %cêטיed#êכל!êמנ!êס`d\"êע✓!êebêפצ!)ç" [file getris-high-score-file score substitute-in-file-name find-file-other-window format "  %08d %20s at %s on %s
  148. " user-full-name current-time-string system-name sort-fields -1 goto-line 11 move-to-column 0 delete-region write-file pop-to-buffer "*Getris*"] 13))
  149.  
  150. (defun getris-move-left nil (byte-code "ב✓    
  151. #êגד✓הZ    
  152. #â⑨✓הZë⓪éə✓    
  153. #ç" [x y piece-data getris-unset-piece getris-set-piece getris-puttable-p 2] 6))
  154.  
  155. (defun getris-move-right nil (byte-code "ב✓    
  156. #êגד✓ה\\    
  157. #â⑨✓ה\\ë⓪éə✓    
  158. #ç" [x y piece-data getris-unset-piece getris-set-piece getris-puttable-p 2] 6))
  159.  
  160. (defun getris-rotate nil (byte-code "    הUâ
  161. וé     T⑧ז
  162. ♪ #êח
  163. ♪ט
  164. ♪
  165. ✓H#â*
  166. ✓ë①Hë④é+ #)ç" [new-direction direction x y piece-data piece-vector 3 0 getris-unset-piece getris-set-piece getris-puttable-p] 9))
  167.  
  168. (defun getris-drop nil (byte-code "ד✓    
  169. #êה✓    T
  170. #à⑦    Të①êé╱ê ë③ç" [x y piece-data delay-count delay getris-unset-piece getris-puttable-p] 5))
  171.  
  172. (defun getris-quit nil (byte-code "אב!àIJë⓪êגדה \"ç" [buffer-read-only t y-or-n-p "Are you sure to quit Getris? " throw getris-quit-tag getris-exit] 5))
  173.  
  174. (defun getris-boss-has-come nil (byte-code "ijïç" [((byte-code "ij êIJאב\"êג ç" [boss-has-come local-set-key "⇨⇨" getris-boss-goes-away recursive-edit] 4))] 1))
  175.  
  176. (defun getris-boss-goes-away nil (interactive) (byte-code "ijêIJ êא ç" [nil boss-goes-away exit-recursive-edit] 3))
  177.  
  178. (defun getris-make-piece-data (raw-piece-data) (byte-code "מ    Gא\"ë⓪êנ    àõנ    @מסא\"╱
  179. àßנאנ
  180. @
  181.     ✓◆
  182. àçנ
  183. @
  184. @G
  185.  ♪♪
  186. Wàv ♪HעUàk♪♪\\◆B✓Bë⑥✓ê◆    Vàk◆ë⑥    ê♪Të⑥♪êé=ê
  187. A⑥
  188. ◆Të⑥◆+êé*ê╱     ✓BI,ê
  189. A⑤ Të④êé⑨ê✓♪╱I+ê    A①♪Të③êé
  190. )ç" [getris-piece-data raw-piece-data nil kind direction four-list four-vector y piece-data max-y lines x line len make-vector 0 4 35] 8))
  191.  
  192. (or getris-piece-data (getris-make-piece-data (quote ((("" "" "####" "") (" #" " #" " #" " #") ("" "####" "" "") ("  #" "  #" "  #" "  #")) (("##" "##") ("##" "##") ("##" "##") ("##" "##")) (("##" " ##") (" #" "##" "#") ("##" " ##") (" #" "##" "#")) ((" ##" "##") ("#" "##" " #") (" ##" "##") ("#" "##" " #")) ((" #" "###") (" #" "##" " #") ("" "###" " #") (" #" " ##" " #")) (("" "###" "#") ("#" "#" "##") ("  #" "###") (" ##" "  #" "  #")) (("" "###" "  #") ("##" "#" "#") ("#" "###") ("  #" "  #" " ##"))))))
  193.